home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / dbms_mag / 9108 / aquarium.aug < prev    next >
Text File  |  1991-06-12  |  4KB  |  106 lines
  1. «LM0»Listing 1: Best of Clipper Aquarium, August 1991
  2.  
  3. 1 /*  
  4. 2    Program: GETTEST.PRG  
  5. 3    Author:  Greg Lief  
  6. 4    Copyright (c) 1991 Greg Lief  
  7. 5    Dialect: Clipper 5.01  
  8. 6    Compile with: clipper gettest /n  
  9. 7    Link with:    rtlink fi gettest /free  
  10. 8    If you want to use the @..GGET command, copy the  
  11. 9    @..GGET directive to your own header file and then  
  12. 10   #include that at the top of your programs.  
  13. 11 */  
  14. 12 #xcommand @ <row>, <col> GGET <var>                       ;
  15. 13                [PICTURE <pic>]                             ;
  16. 14                [VALID <valid>]                           ;
  17. 15                [WHEN <when>]                                ;
  18. 16                [COLOR <color>]                   ;
  19. 17                [MESSAGE <message>]                         ;
  20. 18                                                           ;
  21. 19   => SetPos( <row>, <col> )                                ;
  22. 20     ; AAdd(                                               ;
  23. 21      GetList,                                            ;
  24. 22       _GET_( <var>, <(var)>, <pic>, <{valid}>, <{when}>)    ;
  25. 23           )                                               ; 
  26. 24                                ;
  27. 25      ATail(GetList):reader := { | g | MyReader(g) }       ;
  28. 26        [                             ; 
  29. 27        Atail(GetList):colorDisp( <color> )]          ;
  30. 28        [                         ; 
  31. 29        Atail(GetList):cargo := <message> ]  
  32. 30 
  33. 31 #define TEST    // for compiling test code (optional) 
  34. 32 #ifdef TEST     // begin test code  
  35. 33  
  36. 34 function main  
  37. 35 local x := 0, y := 0, z := 0  
  38. 36 memvar getlist  
  39. 37 cls  
  40. 38 @ 10, 10 gget x message "This is the first GET"  
  41. 39 @ 11, 10 gget y                      // no message  
  42. 40 @ 12, 10 gget z message "This is the last GET"  
  43. 41 read  
  44. 42 return nil  
  45. 43  
  46. 44 #endif                // end test code  
  47. 45 #include "getexit.ch" // needed for exitState constants
  48. 46  
  49. 47 /*  
  50. 48   Function: MyReader()  
  51. 49   Purpose:  Alternate to GetReader()  
  52. 50   Author:   Greg Lief  
  53. 51   Copyright (c) 1991 Greg Lief  
  54. 52   Dialect: Clipper 5.01  
  55. 53 */  
  56. 54 function MyReader( get )  
  57. 55 local mess_row := set(_SET_MESSAGE) 
  58. 56 // row for displaying messages 
  59. 57
  60. 58 // read the GET if the WHEN condition is satisfied  
  61. 59  if ( GetPreValidate(get) )  
  62. 60  
  63. 61   /*  
  64. 62   the above LOCAL declaration and following IF..ENDIF are
  65. 63   the only modifications to the stock GetReader() function
  66. 64   */  
  67. 65
  68. 66   // show message if there is one for this GET  
  69. 67   // note that current SET MESSAGE row will be used  
  70. 68   // if you prefer, you could default these to another row  
  71. 69
  72. 70   if get:cargo != NIL  
  73. 71      @ mess_row, 0 say padc( get:cargo, maxcol() + 1)  
  74. 72   else  
  75. 73      scroll(mess_row, 0, mess_row, maxcol(), 0)  
  76. 74   endif  
  77. 75  
  78. 76   // activate the GET for reading  
  79. 77   get:SetFocus()  
  80. 78  
  81. 79   do while ( get:exitState == GE_NOEXIT )  
  82. 80  
  83. 81      // check for initial typeout (no editable positions)  
  84. 82      if ( get:typeOut )  
  85. 83         get:exitState := GE_ENTER  
  86. 84      endif  
  87. 85  
  88. 86      // apply keystrokes until exit  
  89. 87      do while ( get:exitState == GE_NOEXIT )  
  90. 88         GetApplyKey( get, Inkey(0) )  
  91. 89      enddo  
  92. 90  
  93. 91      // disallow exit if VALID condition is not satisfied
  94. 92      if ( !GetPostValidate(get) )  
  95. 93         get:exitState := GE_NOEXIT  
  96. 94      endif  
  97. 95  
  98. 96   enddo  
  99. 97  
  100. 98   // de-activate the GET  
  101. 99   get:KillFocus()  
  102. 100 
  103. 101 endif  
  104. 102 return  
  105. 103 * eof GETS2.PRG  
  106.